home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ad.arc / ADZIP.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  6.1 KB  |  142 lines
  1. 100  CLEAR:ON ERROR GOTO 9000
  2. 126  GOSUB 5010:GOSUB 3000:GOTO 1660
  3. 155  CLS:COLOR 3,0:LOCATE  12,30:PRINT "QUIT?  <Y>es or <N>o?":COLOR 14,0:LOCATE 12,38:PRINT "Y":LOCATE 12,47:PRINT "N":COLOR 3,0
  4. 156  GOSUB 35020
  5. 157  Y$=INKEY$:IF Y$="" THEN 157 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  6. 158  IF Y$="N" THEN 5025
  7. 159  IF Y$="Y" THEN CLS:LOCATE 12,30:PRINT "GOODBYE":SYSTEM ELSE 156
  8. 200  REM              PRINT
  9. 600  LOCATE 21,25:COLOR 0,7:PRINT "TURN ON PRINTER AND HIT ANY KEY":COLOR 3,0:GOSUB 35010
  10. 610  Y$=INKEY$: IF Y$="" THEN 610
  11. 620  LOCATE 21,25:PRINT SPACE$(40):LOCATE 21,37:COLOR 16,7:PRINT "WORKING"
  12. 630  LOCATE 21,23:COLOR 14,0:PRINT SPACE$(4);"Hit <Esc> to stop printing";SPACE$(10):COLOR 3,0:RETURN
  13. 1000  REM
  14. 1080  PRINT #5, 
  15. 1085  PRINT #5,  SPACE$(TN);T1$
  16. 1090  B=VAL(LEFT$(DATE$,2))
  17. 1095  PRINT #5, :PRINT #5,  SPACE$(30);DQ$(B);" ";MID$(DATE$,4,2);", 19";RIGHT$(DATE$,2):PRINT #5, 
  18. 1100  PRINT #5, 
  19. 1105  MP =10
  20. 1110  RETURN
  21. 1660  IF AG=1 THEN 1690 ELSE GOSUB 5000
  22. 1670  PRINT "PRINT ... ZIPCODE":LOCATE 5,32:PRINT "ENTER:  ZIPCODE & ";ARR$:LOCATE 6,8:PRINT "(Any number of digits and always start from the left most digit)"
  23. 1680  LOCATE 7,39:PRINT "OR":LOCATE 8,32:PRINT "'!' to print all":GOTO 1710
  24. 1690  LOCATE 15,25:PRINT SPACE$(50):LOCATE 22,35:COLOR 0,7:PRINT "ENTER AGAIN":LOCATE 23,28:PRINT Z$;" not in ";FILE$:COLOR 3,0:AG=0
  25. 1710  LOCATE 15,25:COLOR 14,0:INPUT "ZIPCode ... ",Z$:KK=7:X2$=" ZIPCODE "
  26. 1840  MM=LEN(Z$):IF MM=0 THEN 5025
  27. 1841  LOCATE 22,35:PRINT SPACE$(15):LOCATE 23,28:PRINT SPACE$(30):LOCATE 22,37:COLOR 16,7:PRINT "WORKING":COLOR 3,0
  28. 1845  X3$="FILE = ":X4$=SPACE$(15):X5$="FUNCTION = ":X1$="PRINT "
  29. 1850  JJ=0:GET #4,NN+1:I=VAL(V$(16)):IK=0
  30. 1855  IF IK=NN THEN 1920 ELSE IK=IK+1
  31. 1860  GET #4,I
  32. 1870  IF Z$="!" THEN 1890
  33. 1875  GET #4,I
  34. 1880  IF Z$<>MID$(V$(KK),5,MM) THEN  1910
  35. 1890  JJ=JJ+1
  36. 1900  D%(JJ)=I
  37. 1910  IF IK>=NN THEN 1920 ELSE I=VAL(V$(14)):GOTO 1855
  38. 1920  IF JJ=0 THEN GOSUB 35020:AG=1:GOTO 1660 ELSE 2500
  39. 2000  COLOR 10,0:LOCATE 21,24:PRINT "Hit any key to continue PRINTING":GOSUB 35010
  40. 2010  LOCATE 23,26:COLOR 10,0:PRINT "Hit KEY F6 - Return to Menu.":COLOR 3,0
  41. 2020  Y$=INKEY$: IF Y$="" THEN 2020 ELSE GOSUB 630:LOCATE 23,26:PRINT SPACE$(35):RETURN
  42. 2500  REM
  43. 2510  GOSUB 600:GOSUB 1000
  44. 2515  MP1=LP1*6-9:K=1
  45. 2520  I=1
  46. 2530  FOR L=1 TO 2:LL=I+L-1
  47. 2540  GET #4,D%(LL)
  48. 2550  FOR J= 1 TO 7 :A(J,L)=VAL(V$(J)):NEXT
  49. 2560  A(8,L)=VAL(V$(13)):A(9,L)=VAL(V$(12)):A2=A(2,L)
  50. 2570  W$(6,L)=MID$(V$(5),5,A(5,L))+", "+MID$(V$(6),5,A(6,L))+"  "+MID$(V$(7),5,A(7,L))
  51. 2580  IF T$="N" THEN A9=39-A(2,L):GOTO 2600
  52. 2590  A9=39-A(8,L)-A(2,L)
  53. 2600  IF A9<A(1,L) THEN A(1,L)=A9
  54. 2610  A(5,L)=36-A(5,L)-A(6,L)-A(7,L)
  55. 2620  IF T$="N" THEN W$(1,L)=MID$(V$(1),5,A(1,L))+" "+MID$(V$(2),5,A(2,L)):GOTO 2640
  56. 2630  W$(1,L)=MID$(V$(13),5,A(8,L))+MID$(V$(1),5,A(1,L))+" "+MID$(V$(2),5,A(2,L))
  57. 2640  IF A(9,L) <> 0 THEN W$(2,L)=MID$(V$(12),5,30) :GOTO 2670
  58. 2650  IF A(9,L) = 0 AND A(3,L)=0 THEN W$(2,L)=MID$(V$(4),5,30):W$(4,L)="":W$(5,L)="":W$(3,L)=W$(6,L):A(2,L)=10:A(3,L)=A(5,L):A(4,L)=40:A(5,L)=40:GOTO 2690
  59. 2660  IF A(9,L) = 0 AND A(3,L)<>0 THEN W$(2,L)=MID$(V$(3),5,30):W$(3,L)=MID$(V$(4),5,30):W$(4,L)=W$(6,L):W$(5,L)="":A(2,L)=10:A(3,L)=A(2,L):A(4,L)=A(5,L):A(5,L)=40:GOTO 2690
  60. 2670  IF A(3,L)<>0 THEN W$(3,L)=MID$(V$(3),5,30):W$(4,L)=MID$(V$(4),5,30):A(2,L)=10:W$(5,L)=W$(6,L):A(3,L)=10:A(4,L)=10:GOTO 2690
  61. 2680  IF A(9,L) <>0 AND A(3,L)=0 THEN W$(3,L)=MID$(V$(4),5,30):W$(4,L)=W$(6,L):W$(5,L)="":A(2,L)=10:A(3,L)=A(2,L):A(4,L)=A(5,L):A(5,L)=40:GOTO 2690
  62. 2690  IF T$="N" THEN A(1,L)=39-A(1,L)-A2 ELSE A(1,L)=39-A(1,L)-A2-A(8,L)
  63. 2700  IF I =JJ THEN 2880
  64. 2710  IF A(1,L)<=0 THEN A(1,L)=10
  65. 2730  NEXT
  66. 2732  IF MP<MP1 THEN 2740 ELSE K=K+1
  67. 2733  IF LP$="N" OR LP$="n" THEN 2736 ELSE LOCATE 24,20:PRINT "Advance paper and hit any key to continue";:GOSUB 35010
  68. 2734  Y$=INKEY$:IF Y$="" THEN 2734 ELSE LOCATE 24,20:PRINT SPACE$(45);
  69. 2735  PRINT #5,   TAB(35);"-";K;" -":PRINT #5, :PRINT #5,  :MP=6:GOTO 2740
  70. 2736  PRINT #5, CHR$(12):PRINT #5,:PRINT #5,  TAB(35);"- ";K;" -":PRINT #5, :PRINT #5, :MP=5
  71. 2740  IF I<>NN THEN 2750 ELSE IF N1 =0 THEN 2750 ELSE 2880
  72. 2750  FOR K1= 1 TO 3:PRINT #5, TAB(3);W$(K1,1);SPACE$(A(K1,1));W$(K1,2):NEXT
  73. 2760  IF W$(4,1) ="" AND W$(4,2)=""THEN 2770 ELSE PRINT #5, TAB(3);W$(4,1);SPACE$(A(4,1));W$(4,2):MP=MP+1
  74. 2770  IF W$(5,1)="" AND W$(5,2)="" THEN 2780 ELSE PRINT #5, TAB(3);W$(5,1);SPACE$(A(5,1));W$(5,2):MP=MP+1
  75. 2780  MP=MP+5
  76. 2800  PRINT #5,:PRINT #5,
  77. 2805  Y$=INKEY$:IF Y$=CHR$(27) THEN GOSUB 2000
  78. 2810  IF I+1=>JJ OR I=0 THEN 2860 ELSE I=I+2
  79. 2820  IF FRE(1)>1100 THEN 2530
  80. 2830  CHAIN "ADMAIL.BAS",2530,ALL
  81. 2840  GOSUB 5010
  82. 2850  GOTO 2530
  83. 2860  CLOSE #4
  84. 2870  GOTO 5025
  85. 2880  FOR K1= 1 TO 5:PRINT #5, TAB(3);W$(K1,1):NEXT
  86. 2910  GOTO 5025
  87. 3000  O5$=CHR$(218)+CHR$(196)+CHR$(191):O6$=CHR$(179)+" "+CHR$(179):O7$=CHR$(192)+CHR$(196)+CHR$(217)
  88. 3010  O$=CHR$(219):O2$=CHR$(221):O1$="F KEYS:"+O$+O$+"F1:MAIN menu"+O2$+"F2:ZIPCODE"+O2$+"F6:PRINT menu"+O2$+"F8:NAMES"+O2$+"F4:NOTES"
  89. 3020  DIM DQ$(12):FOR I= 1 TO 12:READ DQ$(I):NEXT
  90. 3030  DATA JANUARY, FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  91. 3040  WIDTH "LPT1:",82
  92. 3050  OPEN "TEMPOR.TEM" FOR INPUT AS #1
  93. 3055  INPUT #1, FILE$,FILM$,FIL$:CLOSE #1
  94. 3056  OPEN FILM$ FOR INPUT AS #2
  95. 3060  INPUT #2,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:CLOSE #2
  96. 3065  DIM V$(16),D%(NN),W$(9,3),A(9,3)
  97. 3070  IF PT$="I" THEN OPEN "LPT1:" FOR OUTPUT AS #5:GOTO 3090
  98. 3080  OPEN "LPT2:" FOR OUTPUT AS #5
  99. 3090  OPEN FILE$ AS #4 LEN = 356
  100. 3100  FIELD #4, 19 AS V$(1), 19 AS V$(2), 18 AS V$(13), 34 AS V$(12), 34 AS V$(3), 34 AS V$(4), 19 AS V$(5), 14 AS V$(6), 16 AS V$(7), 12 AS V$(8), 84 AS V$(9), 19 AS V$(10), 19 AS V$(11), 5 AS V$(14), 5 AS V$(15), 5 AS V$(16)
  101. 3120  FILN$=FIL$+".NTE"
  102. 3130  RETURN
  103. 4000  REM
  104. 4010  OPEN FILN$ FOR INPUT AS #2
  105. 4030  FOR I= 1 TO 20:INPUT #2, NKEY$(I),NOTE$(I):IF NKEY$(I)=CHR$(15) THEN 4035 ELSE NEXT
  106. 4035  NP=I-1:CLOSE#2
  107. 4040  GOSUB 5000
  108. 4050  LOCATE 1,1:PRINT "NOTES:  KEYS":LOCATE 1,30:COLOR 14,0:PRINT "KEYS       ";:COLOR 3,0:PRINT " DESCRIPTION":FOR I=1 TO NP:COLOR 14,0:LOCATE 4+I,30:PRINT NKEY$(I);:COLOR 3,0:LOCATE ,40:PRINT " = ";NOTE$(I):NEXT
  109. 4060  LOCATE 20,28:COLOR 14,0:PRINT "HIT ANY KEY TO CONTINUE":COLOR 3,0
  110. 4065  Y$=INKEY$:IF Y$="" THEN 4065 ELSE 5025
  111. 5000  CLS:LOCATE 25,1:COLOR 0,7,1:PRINT O1$;:COLOR 3,0:LOCATE 1,1:RETURN
  112. 5010  ON KEY(1) GOSUB 5070:ON KEY(2) GOSUB 5030:KEY(1) ON:KEY(2) ON:
  113. 5015  ON KEY(6) GOSUB 5025:KEY(6) ON:ON KEY(8) GOSUB 4000:KEY(8) ON:ON KEY(7) GOSUB 20000:KEY(7) ON:RETURN
  114. 5020  Y$=INKEY$:IF Y$="" THEN LOCATE 3,69:PRINT TIME$:GOTO 5020 ELSE RETURN
  115. 5025  A$="PRINT":Y1=6:GOTO 5080
  116. 5030  GOTO 1660
  117. 5070  A$="MAIN":Y1=1
  118. 5080  CLS:LOCATE 25,25:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";:COLOR 3,0:LOCATE 12,21:PRINT "PLEASE WAIT, LOADING ";A$;" ROUTINES"
  119. 5085  IF Y1=6 THEN RUN "ADPRT.BAS"
  120. 5090  A$="AD"+A$:RUN A$
  121. 9000  IF ERR = 27 THEN CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"PRINTER ERROR ":COLOR 7,1:LOCATE 1,1
  122. 9030  IF ERR = 27 THEN PRINT "CHECK THE PRINTER":FOR I= 1 TO 500:NEXT I:RESUME 5025
  123. 9040  IF ERR =53 THEN CLS:LOCATE 10,15:PRINT "File containing KEYS used in NOTES does not exist.":LOCATE 12,22:PRINT "Return to EDIT program to create file." :LOCATE 18,30:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030:Y$=INPUT$(1):RESUME 5025
  124. 9050  CLS:LOCATE 10,28:PRINT "ERROR ";ERR;" ENCOUNTERED":LOCATE 18,26:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030
  125. 9060  Y$=INKEY$:IF Y$="" THEN 9060
  126. 9070  RESUME 5025
  127. 20000  A$="ADPRT":CHAIN "ADNAME",20000,ALL
  128. 20210  Y$=INKEY$:IF Y$="" THEN 20210 ELSE GOSUB 5000:RETURN
  129. 30000  CLS:LOCATE 25,25:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";:COLOR 3,0:LOCATE 1,1
  130. 30010  OPEN "AD.HLP" AS #2 LEN=78
  131. 30020  FIELD #2, 78 AS A$
  132. 30030  I=1:M=1
  133. 30040  GET #2,I
  134. 30090  IF LEFT$(A$,1) <> CHR$(15) THEN PRINT A$ :I=I+1:GOTO 30040 ELSE 30130
  135. 30130  LOCATE 24,27:COLOR 14,0:PRINT "HIT ANY KEY TO CONTINUE";:COLOR 3,0:GOSUB 35030
  136. 30140  Y$=INKEY$:IF Y$="" THEN 30140
  137. 30150  CLOSE #2:GOTO 200
  138. 35000  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 4:SOUND 500*SS%,2:NEXT:RETURN
  139. 35010  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 3:SOUND 1000*SS%,1:NEXT:FOR SS%= 3 TO 1:SOUND 1000*SS%,1:NEXT:RETURN
  140. 35020  IF SND$="N" THEN RETURN ELSE BEEP:RETURN
  141. 35030  IF SND$="N" THEN RETURN ELSE SOUND 750,2:SOUND 30000,2:SOUND 750,2:RETURN
  142.